home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 April / macformat-023.iso / Shareware City / Developers / Hotlist2HTML0.7.2_source folder / Hotlist2HTML.f next >
Encoding:
Text File  |  1994-11-01  |  8.2 KB  |  303 lines  |  [TEXT/MPS ]
  1. !!MP    inlines.f
  2.     program hotlis
  3. c
  4. c   Hotlist2HTML
  5. c
  6. c   Reads a NCSA Mosaic (up from V. 1.0.2) Hotlist or a MacWeb Hotlist
  7. c   and generates a HTML page from it. By default, the HTML Output is sorted
  8. c   lexigraphically according to the Hotlist menu titles - but sorting
  9. c   may be optionally suppressed. The HTML output is written to a user 
  10. c   selectable file.
  11. c
  12. c   Compilation of this program requires the Language Systems Fortran 3.0
  13. c   compiler or a later Version, running under MPW 3.2.3.
  14. c   Furthermore, System 7 Toolbox routines are called. 
  15. c
  16. c   Lutz Weimann   Version 0.7.2     1.11.94
  17. c
  18.     implicit none
  19. c
  20. !!I        Standardfile.f
  21. c
  22.     integer outunit
  23.     parameter (outunit=20)
  24.     integer MaxListLength
  25.     parameter(MaxListLength=1000)
  26. c
  27.     Integer ActualListLength, Mode
  28.     string*8 HTMLBrowser
  29.     integer*2 refnum, vRefNum, err
  30.     pointer /ptr/ menuh, urlsh, hotlisth
  31.     record /SFTypeList/ MyTypes
  32.     record /StandardFileReply/ ReplyRecord
  33.     string*255 HotlistName, thestring
  34.     string*255 Menu(MaxListLength), URLs(MaxListLength)
  35. c
  36.     call InitialAboutBox(Mode)
  37. c
  38.     MyTypes.OSTy(0)='HOTL'
  39.     MyTypes.OSTy(1)='HLST'
  40.     Call StandardGetFile(nil,Int2(2),MyTypes,ReplyRecord)
  41.     if (.not.ReplyRecord.sfGood) stop 'Hotlist selection canceled!'
  42.     HotlistName = ReplyRecord.sfFile.name
  43. c
  44.     refnum = FSpOpenResfile(ReplyRecord.sfFile,Int1(1))
  45.     if (ResError().ne.0) stop 'OpenResfile: Cannot open Hotlist!'
  46. c
  47.     call UseResFile(refnum)
  48.     if (ResError().ne.0) stop 'UseResFile failed!'
  49. c
  50.     if (ReplyRecord.sfType.F .eq. 'HOTL') then
  51. c
  52.         HTMLBrowser='Mosaic'
  53.         thestring = 'Menu'
  54.         menuh = GetNamedResource('STR#',thestring)
  55.         if (ResError().ne.0) stop 'Cant find STR# Resource Menu!'
  56. c
  57.         thestring = 'URLs'
  58.         urlsh = GetNamedResource('STR#',thestring)
  59.         if (ResError().ne.0) stop 'Cant find STR# Resource URLs!'
  60. c
  61.         call ReadInMosaicHotlist(%val(menuh^.p), %val(urlsh^.p),
  62.      $                           MaxListLength, Menu, URLs,
  63.      $                           ActualListLength)
  64. c
  65.     else if (ReplyRecord.sfType.F .eq. 'HLST') then
  66. c
  67.         HTMLBrowser='MacWeb'
  68.         thestring = 'Hotlist'
  69.         hotlisth = GetNamedResource('STR#',thestring)
  70.         if (ResError().ne.0) stop 'Cant find STR# Resource Hotlist!'
  71. c
  72.         call ReadInMacWebHotlist(%val(hotlisth^.p), MaxListLength,  
  73.      $                           Menu, URLs, ActualListLength)
  74. c
  75.     else
  76.         stop 'Input file has an unknown type!'
  77.     endif
  78. c
  79.     if (Mode.eq.0) Call HotlistSort(ActualListLength, Menu, URLs)
  80. c
  81.     call F_SetDefaultFileName (HotlistName//'.html')
  82.     open (outunit,file=*'Save HTML page as:',status='new',
  83.      $    creator='ttxt')
  84. c
  85.     call WriteHTMLfile(outunit, HotlistName, ActualListLength,
  86.      $                 Menu, URLs, HTMLBrowser)
  87. c
  88.     close(outunit)
  89.      call CloseResFile(refnum)
  90.     if (ResError().ne.0) stop 'CloseResFile failed!'
  91.     end
  92. c
  93. c
  94.     subroutine ReadInMosaicHotlist(Menu, URLs, MaxListLength,
  95.      $                             MenuStor, URLsStor, ActListLength)
  96.     implicit none
  97.     integer*1 Menu(*), URLs(*)
  98.     integer MaxListLength, ActListLength
  99.     string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
  100. c
  101.     integer numMenu, numURLs, ptrMenu, ptrURLs, lMenu, lURLs,
  102.      $      i, j, temp1, temp2
  103.     character*255 CharMenuBuf, CharURLsBuf
  104.     integer*1 IntMenuBuf(255), IntURLsBuf(255)
  105.     equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
  106.     character*255 Message
  107. c
  108.     
  109.     temp1 = Menu(1)
  110.     if (temp1.lt.0) temp1=256+temp1
  111.     temp2 = Menu(2)
  112.     if (temp2.lt.0) temp2=256+temp2
  113.     numMenu = temp1*256+temp2
  114.     temp1 = URLs(1)
  115.     if (temp1.lt.0) temp1=256+temp1
  116.     temp2 = URLs(2)
  117.     if (temp2.lt.0) temp2=256+temp2
  118.     numURLs = temp1*256+temp2
  119.     if (numMenu.ne.numURLs) then
  120.         Message = 'Different number of menuitems and URLs found.'//
  121.      $            'I generate a list of the lower number length'
  122.         call AlertBox(Message)
  123.     endif
  124.     ActListLength = min(numMenu, numURLs)
  125.     if (ActListLength.gt.MaxListLength) then
  126.         write(Message,1001) ActListLength, MaxListLength
  127.         call AlertBox(Message)
  128.         ActListLength = MaxListLength
  129.     endif
  130.     ptrMenu = 3
  131.     ptrURLs = 3
  132.     do i=1,ActListLength
  133.         lMenu = Menu(ptrMenu)
  134.         if (lMenu.lt.0) lMenu=256+lMenu
  135.         do j=1,lMenu
  136.             IntMenuBuf(j) = Menu(ptrMenu+j)
  137.         enddo
  138.         ptrMenu = ptrMenu+lMenu+1
  139.         MenuStor(i) = CharMenuBuf(1:lMenu)
  140.         lURLs = URLs(ptrURLs)
  141.         if (lURLs.lt.0) lURLs=256+lURLs
  142.         do j=1,lURLs
  143.             IntURLsBuf(j) = URLs(ptrURLs+j)
  144.         enddo
  145.         ptrURLs = ptrURLs+lURLs+1
  146.         URLsStor(i) = CharURLsBuf(1:lURLs)
  147.     enddo
  148.     return
  149. c
  150. 1001    format('Your Hotlist has ',i4,' entries - too much for me.',
  151.      $         'Only the first ',i4,' entries are converted to HTML')
  152.     end
  153. c
  154. c
  155.     subroutine ReadInMacWebHotlist(Hotlist, MaxListLength,
  156.      $                             MenuStor, URLsStor, ActListLength)
  157.     implicit none
  158.     integer*1 Hotlist(*)
  159.     integer MaxListLength, ActListLength
  160.     string*255 MenuStor(MaxListLength), URLsStor(MaxListLength)
  161. c
  162.     integer numItems, ptrMenu, ptrURLs, lMenu, lURLs,
  163.      $      i, j, temp1, temp2
  164.     character*255 CharMenuBuf, CharURLsBuf
  165.     integer*1 IntMenuBuf(255), IntURLsBuf(255)
  166.     equivalence (CharMenuBuf,IntMenuBuf), (CharURLsBuf,IntURLsBuf)
  167.     character*255 Message
  168. c
  169.     temp1 = Hotlist(1)
  170.     if (temp1.lt.0) temp1=256+temp1
  171.     temp2 = Hotlist(2)
  172.     if (temp2.lt.0) temp2=256+temp2
  173.     numItems = temp1*256+temp2
  174.     ActListLength = NumItems/2
  175.     if (ActListLength*2.ne.NumItems) then
  176.         Message = 'Inconsistent number of menu titles and URLs '//
  177.      $            'in the MacWeb Hotlist. Something may be '//
  178.      $            'missed within the HTML output.'
  179.         call AlertBox(Message)
  180.     endif
  181.     if (ActListLength.gt.MaxListLength) then
  182.         write(Message,1001) ActListLength, MaxListLength
  183.         call AlertBox(Message)
  184.         ActListLength = MaxListLength
  185.     endif
  186.     ptrMenu = 3
  187.     do i=1,ActListLength
  188.         lMenu = Hotlist(ptrMenu)
  189.         if (lMenu.lt.0) lMenu=256+lMenu
  190.         do j=1,lMenu
  191.             IntMenuBuf(j) = Hotlist(ptrMenu+j)
  192.         enddo
  193.         ptrURLs = ptrMenu+lMenu+1
  194.         MenuStor(i) = CharMenuBuf(1:lMenu)
  195.         lURLs = Hotlist(ptrURLs)
  196.         if (lURLs.lt.0) lURLs=256+lURLs
  197.         do j=1,lURLs
  198.             IntURLsBuf(j) = Hotlist(ptrURLs+j)
  199.         enddo
  200.         ptrMenu = ptrURLs+lURLs+1
  201.         URLsStor(i) = CharURLsBuf(1:lURLs)
  202.     enddo
  203.     return
  204. c
  205. 1001  format('Your Hotlist has ',i4,' entries - too much for me.',
  206.      $         'Only the first ',i4,' entries are converted to HTML')
  207.     end
  208. c
  209. c
  210.     subroutine WriteHTMLfile(outunit, HotlistFileName, ActualListLength,
  211.      $                       Menu, URLs, HTMLBrowser)
  212.     implicit none
  213.     integer outunit
  214.     string*255 HotlistFileName
  215.     integer ActualListLength
  216.     string*255 Menu(ActualListLength), URLs(ActualListLength)
  217.     string*8 HTMLBrowser
  218. c
  219.     string*255 Message
  220.     character*9 datestring
  221.     integer i
  222. c
  223.     write(outunit,1001) HotlistFileName, HotlistFileName
  224.     do i=1,ActualListLength
  225.         write(outunit,1002) URLs(i), Menu(i)
  226.     enddo
  227.     call date(datestring)
  228.     write(outunit,1003) HTMLBrowser, HotlistFileName, datestring
  229.     return
  230. c
  231. 1001  format('<TITLE>',a,'</TITLE>',/,'<H1>',a,'</H1>','<UL>')
  232. 1002  format('<LI> <A HREF="',a,'">',a,'</A>')
  233. 1003  format('</UL>',/,'<ADDRESS>Generated from ',a,'-Hotlist ',a,
  234.      $       ' at ',a,'</ADDRESS>',/)
  235.     end
  236. c
  237. c
  238.     Subroutine HotlistSort(ActualListLength, Menu, URLs)
  239.     implicit none
  240. c
  241. c    A simple (and not most quick) sort routine.
  242. c    Sorts the Hotlist lexically according to the names of the MenuItems.
  243. c
  244.     integer ActualListLength
  245.     string*255 Menu(ActualListLength), URLs(ActualListLength)
  246. c
  247.     string*255 MenuLow, URLsLow
  248.     integer i,j,indexLow
  249. c
  250.     do i=1,ActualListLength-1
  251.         MenuLow = Menu(i)
  252.         indexLow = i
  253.         do j=i+1,ActualListLength
  254.             if (Menu(j).lt.MenuLow) then
  255.                 MenuLow = Menu(j)
  256.                 indexLow = j
  257.             endif
  258.         enddo
  259.         URLsLow = URLs(indexLow)
  260.         Menu(indexLow) = Menu(i)
  261.         URLs(indexLow) = URLs(i)
  262.         Menu(i) = MenuLow
  263.         URLs(i) = URLsLow
  264.     enddo
  265.     return
  266.     end
  267. c
  268. c
  269.     Subroutine InitialAboutBox(Mode)
  270.     implicit none
  271.     integer Mode
  272. c
  273. !!I    Dialogs.f
  274. !!I    Events.f
  275. c
  276.     integer*2 AboutDialogID
  277.     parameter (AboutDialogID=32002)
  278. c
  279.     record /EventRecord/ theEvent
  280.     record /DialogRecord/ AboutDialog
  281.     record /DialogPtr/ AboutDialogPtr
  282.     integer*2 itemhit
  283.     logical status
  284. c
  285.     call InitDialogs(nil)
  286.     AboutDialogPtr = GetNewDialog(AboutDialogID, %ref(AboutDialog), -1)
  287. c
  288.     do while (.not.GetNextEvent(mDownMask,theEvent))
  289.         if (GetNextEvent(updateMask,theEvent)) then
  290.             if (.not.IsDialogEvent(theEvent)) cycle
  291.             status = DialogSelect(theEvent,%ref(AboutDialogPtr),%ref(itemhit))
  292.         endif
  293.     enddo
  294. C   Mode = 0: Shift key not pressed;  Mode=1: Shift key pressed
  295.     Mode = IAND(theEvent.modifiers,Z'200')
  296.     if (Mode.ne.0) Mode=1
  297.     call DisposDialog(AboutDialogPtr)
  298.     return
  299.     end
  300.     
  301.     
  302.     
  303.